home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / recurs1a / domtree.frm < prev    next >
Text File  |  1999-08-27  |  18KB  |  536 lines

  1. VERSION 5.00
  2. Object = "{EAB22AC0-30C1-11CF-A7EB-0000C05BAE0B}#1.1#0"; "SHDOCVW.DLL"
  3. Begin VB.Form frmDOMTree 
  4.    BackColor       =   &H00FFFFFF&
  5.    Caption         =   "DOM Tree"
  6.    ClientHeight    =   4395
  7.    ClientLeft      =   60
  8.    ClientTop       =   630
  9.    ClientWidth     =   5880
  10.    LinkTopic       =   "Form1"
  11.    MDIChild        =   -1  'True
  12.    ScaleHeight     =   4395
  13.    ScaleWidth      =   5880
  14.    WindowState     =   2  'Maximized
  15.    Begin SHDocVwCtl.WebBrowser wbr 
  16.       Height          =   2235
  17.       Left            =   720
  18.       TabIndex        =   0
  19.       Top             =   840
  20.       Width           =   4515
  21.       ExtentX         =   7964
  22.       ExtentY         =   3942
  23.       ViewMode        =   0
  24.       Offline         =   0
  25.       Silent          =   0
  26.       RegisterAsBrowser=   0
  27.       RegisterAsDropTarget=   1
  28.       AutoArrange     =   0   'False
  29.       NoClientEdge    =   0   'False
  30.       AlignLeft       =   0   'False
  31.       ViewID          =   "{0057D0E0-3573-11CF-AE69-08002B2E1262}"
  32.       Location        =   ""
  33.    End
  34.    Begin VB.Menu mnuFileMenu 
  35.       Caption         =   "&File"
  36.       Index           =   0
  37.       Begin VB.Menu mnuFile 
  38.          Caption         =   "&HTML"
  39.          Index           =   0
  40.       End
  41.       Begin VB.Menu mnuFile 
  42.          Caption         =   "-"
  43.          Index           =   1
  44.       End
  45.       Begin VB.Menu mnuFile 
  46.          Caption         =   "&Close"
  47.          Index           =   2
  48.       End
  49.    End
  50. End
  51. Attribute VB_Name = "frmDOMTree"
  52. Attribute VB_GlobalNameSpace = False
  53. Attribute VB_Creatable = False
  54. Attribute VB_PredeclaredId = True
  55. Attribute VB_Exposed = False
  56. Option Explicit
  57. ' DOMTree.frm   July 1999  contact markb@orionstudios.com
  58. ' Demonstrates DOM programming from Vb6 including
  59. '   recursive traversal of an HTML document structure   (see RecurseDOMTree)
  60. '   extracting stylesheet information from a document   (see DisplayStyleSheets)
  61. '   constructing an expand/collapse UL object and inserting it into a document
  62. '   cloning a structure (see CreatePropsClone, CreateInfoSpan)
  63. '   intercepting click events from WebBrowser document  (see mProps, mExpand)
  64. '   behavior (DOMTree.htc) attached to DIV (MainDIV) via CSS class (DOMTree.css)
  65. '
  66. ' Requires Project/References entry for
  67. '   Microsoft HTML Object Library (MSHTML.tlb)
  68. '====================================================================================
  69. ' Enumerations
  70. Public Enum DOMInfoType ' determines which display is built - see DisplayDOMInfo
  71.     domiTree    ' Document Tree
  72.     domiStyle   ' Style Specs
  73. End Enum
  74. ' Module-level Object variables
  75. Private mvarMDIParent As MDIForm    ' useful to access parent form - see StatusText
  76. Private mDOMDoc As MSHTML.HTMLDocument  ' document to be analysed - see DisplayDOMInfo
  77. Private mWbrDoc As MSHTML.HTMLDocument  ' document in WebBrowser (HTML_TEMPLATE)
  78. Private mWbrDocWin As MSHTML.HTMLWindow2    ' window containing WebBrowser document
  79. Attribute mWbrDocWin.VB_VarHelpID = -1
  80. Private mULRoot As MSHTML.HTMLUListElement      ' top-level UL added to WebBrowser document
  81. Private mCloneSPAN As MSHTML.HTMLSpanElement    ' see CreatePropsClone
  82. ' Objects in WebBrowser document HTML_TEMPLATE
  83. Private mProgressNodes As MSHTML.IHTMLDOMTextNode   ' progress display
  84. Private WithEvents mProps As MSHTML.HTMLTableCell   ' toggles properties display
  85. Attribute mProps.VB_VarHelpID = -1
  86. Private WithEvents mExpand As MSHTML.HTMLTableCell  ' expands/collapses tree display
  87. Attribute mExpand.VB_VarHelpID = -1
  88. ' Miscellaneous module-level variables
  89. Private mDefaultPath As String      ' assigned in Form_Initialize
  90. Private mDOMInfoType As DOMInfoType ' indicates which display is built
  91. Private mDOMInfoCaption As Variant  ' array of caption strings
  92. Private mNodeCount As Long          ' compared with PROGRESS_INTERVAL
  93. ' Module-level Constants
  94. Private Const PROGRESS_INTERVAL As Long = 20    ' see AddLInode_Exit
  95. Private Const HTML_TEMPLATE = "DOMTree.htm"     ' template for building display
  96. Private Const CL_INFOSPAN = "infoSPAN"
  97. Private Const CL_PARENT = "clParent"
  98. Private Const CL_CHILD = "clChild"
  99. Private Const WORKING = " Working ..."
  100. Private Const READY = " Ready"
  101. ' Relevant nodeType constants
  102. Private Const ELEMENT_NODE = 1
  103. Private Const TEXT_NODE = 3
  104. ' Browser navigation constants
  105. Private Const navNoHistory = 2
  106. ' File Menu Constants
  107. Private Const FILE_HTML = 0
  108. Private Const FILE_CLOSE = 2
  109.  
  110. Public Property Set MDIParent(vData As MDIForm) ' optional
  111.    Set mvarMDIParent = vData
  112. End Property
  113.  
  114. Private Property Let StatusText(ByVal vData As String)
  115.  
  116.     On Error Resume Next
  117.     
  118.     If Not (mvarMDIParent Is Nothing) Then  ' property spec is optional
  119.         mvarMDIParent.StatusText = vData
  120.     End If
  121.     
  122. End Property
  123.  
  124. Public Sub DisplayDOMInfo( _
  125.             HTMLDoc As MSHTML.HTMLDocument, _
  126.             InfoType As DOMInfoType)
  127.             
  128.     Set mDOMDoc = HTMLDoc   ' retain as module-level variable
  129.     mDOMInfoType = InfoType ' retain as module-level variable
  130.     Me.Caption = mDOMInfoCaption(mDOMInfoType)
  131.     
  132. ' Processing is triggered when HTML_TEMPLATE is loaded (see wbr_DocumentComplete)
  133.     wbr.Navigate URL:=mDefaultPath & HTML_TEMPLATE, Flags:=navNoHistory
  134.  
  135. End Sub
  136.  
  137. Private Sub Form_Initialize()
  138.     mDefaultPath = App.Path & "\"
  139.     mDOMInfoCaption = Array("Document Tree", "Style Specs")
  140.     mDOMInfoType = domiTree  ' default DOMDocInfo property
  141. End Sub
  142.  
  143. Private Sub Form_Load()
  144.     StatusText = WORKING
  145.     wbr.Navigate "about:<BODY style='overflow:auto'></BODY>", Flags:=navNoHistory
  146. End Sub
  147.  
  148. Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
  149.     Me.Visible = False  ' An attempt to speed up closing the form because
  150.     DoEvents            '   displosing of the document may take a while.
  151. End Sub
  152.  
  153. Private Sub Form_Resize()
  154.     On Error Resume Next
  155.     wbr.Move 0, 0, Me.ScaleWidth, Me.ScaleHeight
  156. End Sub
  157.  
  158. Private Sub mnuFile_Click(Index As Integer)
  159.  
  160.     On Error Resume Next
  161.     
  162.     Select Case Index
  163.     
  164.         Case FILE_HTML
  165.         
  166.             With New frmDOMHTML
  167.                 .Show
  168.                 .DisplayHTML HTMLDoc:=wbr.Document
  169.             End With
  170.             
  171.         Case FILE_CLOSE
  172.         
  173.             Unload Me
  174.             
  175.     End Select
  176.     
  177. End Sub
  178.  
  179. Private Sub wbr_DocumentComplete(ByVal pDisp As Object, URL As Variant)
  180.  
  181.     If pDisp Is wbr.object Then
  182.         If InStr(1, URL, HTML_TEMPLATE, vbTextCompare) Then
  183.             Set mWbrDoc = wbr.Document  ' typecast for early binding
  184.             With mWbrDoc
  185.                 Set mWbrDocWin = .parentWindow
  186.                 Set mProgressNodes = .getElementById("idRow").firstChild
  187.                 .getElementById("idHdr").firstChild.nodeValue = mDOMInfoCaption(mDOMInfoType)
  188.             End With
  189.             DoEvents
  190.             Select Case mDOMInfoType
  191.                 Case domiTree
  192.                     RecurseDOMTree StartFromNode:=mDOMDoc.getElementsByTagName("HTML")(0)
  193.                 Case domiStyle
  194.                     DisplayStyleSheets HTMLDoc:=mDOMDoc
  195.             End Select
  196.             StatusText = READY
  197.         End If
  198.     End If
  199.     
  200. End Sub
  201.  
  202. Private Function mProps_onclick() As Boolean    ' Event generated in HTML_TEMPLATE
  203.  
  204.     Dim blnShow As Boolean
  205.     
  206.     StatusText = WORKING
  207.     mWbrDocWin.Event.cancelBubble = True
  208.     blnShow = InStr(1, mProps.firstChild.nodeValue, "Show", vbTextCompare)
  209.     PropsToggle ShowAll:=blnShow
  210.     mProps.firstChild.nodeValue = IIf(blnShow, "Hide", "Show") & " properties"
  211.     StatusText = READY
  212.     
  213. End Function
  214.  
  215. Private Function mExpand_onclick() As Boolean   ' Event generated in HTML_TEMPLATE
  216.  
  217.     Dim blnExpand As Boolean
  218.     
  219.     StatusText = WORKING
  220.     mWbrDocWin.Event.cancelBubble = True
  221.     blnExpand = InStr(1, mExpand.firstChild.nodeValue, "Expand", vbTextCompare)
  222.     ExpandToggle ExpandAll:=blnExpand
  223.     mExpand.firstChild.nodeValue = IIf(blnExpand, "Collapse", "Expand") & " all"
  224.     StatusText = READY
  225.     
  226. End Function
  227.  
  228. Private Sub RecurseDOMTree(StartFromNode As MSHTML.IHTMLDOM